PC Professionell 2006 May/PCpro_2006_05.ISO/files/mobile/fma-2.0-stable-setup.exe/{app}/source/uWaitComplete.pas

Pascal/Delphi Source File | 2004-10-14 | 6.1 KB | 228 lines

unit uWaitComplete;

{
*******************************************************************************
* Descriptions: Sony Ericsson progress bar
* $Source: /cvsroot/fma/fma/uWaitComplete.pas,v $
* $Locker:  $
*
* Todo:
*    - remove ErrorOccured, use DebugStr only as error flag.
*
* Change Log:
* $Log: uWaitComplete.pas,v $
* Revision 1.13.6.1  2004/10/14 16:43:28  z_stoichev
* Bugfixes
*
* Revision 1.13  2004/07/02 20:12:15  z_stoichev
* no message
*
* Revision 1.12  2004/07/02 18:14:17  lordlarry
* Fixed 100% CPU when communicating
*
* Revision 1.11  2004/06/28 22:42:26  z_stoichev
* Possible freeze fixed
*
* Revision 1.10  2004/06/28 09:12:38  z_stoichev
* Bugfixes
*
* Revision 1.9  2004/06/25 08:11:25  z_stoichev
* Added Message storage is 90% full warning.
*
* Revision 1.8  2004/05/19 18:34:16  z_stoichev
* Build 0.1.0.35c
*
* Revision 1.7  2004/03/11 13:38:16  z_stoichev
* Show user friendly message on AT error.
*
* Revision 1.6  2004/03/08 09:57:54  z_stoichev
* Fixed timeout on long operations.
*
* Revision 1.5  2004/02/03 16:29:03  z_stoichev
* Bugfixes.
*
* Revision 1.4  2004/01/26 10:32:12  z_stoichev
* Added uWaitComplete again.
*
* Revision 1.2  2003/12/04 16:22:33  z_stoichev
* Bugfixes
*
*
}

interface

uses
  Forms, Windows, Classes, Controls, SysUtils;

type
  TWaitThread = class(TThread)
  private
    { Private declarations }
    DebugStr: String;
    FIsFinished: Boolean;
    FIsStarted: Boolean;
    procedure DoDebug;
    procedure ShowDebug(str: String);
    function Get_IsErrorOccur: Boolean;
  protected
    TxData,RcWait: String;
    ErrorOccured: Boolean;
    procedure Execute; override;
  public
    constructor Create(SendData,WaitFor: string);
    function GetLastError: string;
  published
    property Started: Boolean read FIsStarted;
    property Finished: Boolean read FIsFinished;
    property IsErrorOccur: Boolean read Get_IsErrorOccur;
  end;

implementation

uses
  Unit1, gsm_sms;

{ Important: Methods and properties of objects in VCL or CLX can only be used
  in a method called using Synchronize, for example,

      Synchronize(UpdateCaption);

  and UpdateCaption could look like,

    procedure TWaitThread.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }

{ TWaitThread }

constructor TWaitThread.Create(SendData, WaitFor: string);
begin
  TxData := SendData;
  RcWait := WaitFor;
  FIsFinished := False;
  inherited Create(False);
end;

procedure TWaitThread.DoDebug;
begin
  if ErrorOccured then
    Form1.Debug('ERROR: '+DebugStr)
  else begin
    Form1.Debug('[TX] '+DebugStr);
    DebugStr := '';
  end;
end;

procedure TWaitThread.Execute;
begin
  ReturnValue := 0;
  ErrorOccured := False;
  { Wait for any previous thread to finish }
  repeat
    if not Form1.FWaitingOK and //not Form1.FScriptRunning and
       (WaitForSingleObject(Form1.FWaitCompleteIsBusyEvent,50) = WAIT_OBJECT_0) then break;
    if Form1.FAbort or Application.Terminated or Terminated then begin
      Form1.ActiveThread := nil;
      FIsFinished := True;
      FIsStarted := True;
      exit;
    end;
  until False;
  { Ok, continue }
  FIsStarted := True;
  Screen.Cursor := crAppStart;
  with Form1 do try
    FBusy := True;
    ActiveThread := Self;
    FWaitStr := RcWait;
    FLastCommand := TxData;
    ResetEvent(FWaitCompleteEvent);
    if TxData <> '' then begin
      if (TxData = 'AT*EOBEX') and (FWaitStr = 'CONNECT') then begin
        FAlreadyInUseObex := False;
        FObexConnecting := True;
      end;
      if Pos('AT+CPMS="',TxData) = 1 then
        Form1.FLastMessageStore := Copy(TxData,10,2); // ME or SM or...
      { Convert data }
      ShowDebug(TxData);
      if FDoCharConvertion then begin
        TxData := ConvertCharSet(TxData, True);
      end;
      { Where and when to clear FRxBuffer ? }
      if not FWaitingOK then
        FRxBuffer.Clear;
      //ShowDebug('RxBuffer: '+IntToStr(FRxBuffer.Count)+' line(s) so far');
      FWaitingOK := RcWait = 'OK';
      { Send data... }
      FMSec := GetTickCount + FInactivityTimeout;
      if FConnectionType = 0 then WBtSocket.SendStr(TxData + #13)
      else if FConnectionType = 1 then WIrSocket.SendStr(TxData + #13)
      else ComPort.WriteStr(TxData + #13); // Serial
    end
    else
      FMSec := GetTickCount + 500;
    { Wait complete }
    FTimedout := False;
    while (WaitForSingleObject(FWaitCompleteEvent, 200) = WAIT_TIMEOUT) and not FAbort and not FTimedout do begin
      FTimedout := not (GetTickCount < FMSec);
      if Application.Terminated then FAbort := True;
    end;
    if FWaitStr = 'ERROR' then begin
      ErrorOccured := True;
      ShowDebug('Command return error or not understood ('+TxData+')');
      FWaitStr := '';
    end;
    { Do not error or timeout on stray response check }
    if TxData = '' then begin
      FTimedout := False;
      ErrorOccured := False;
    end;
    { Check for timeout }
    if not FAlreadyInUseObex and FTimedout then begin
      ErrorOccured := True;
      if not IsAutoConnect then ShowDebug('Wait timeout')
        else DebugStr := 'Wait timeout'; // be silent in re-connect mode
    end;
    { Check for user abort }
    if FAbort then begin
      FAbortDetected := True;
      FAbort := False;
      ErrorOccured := True;
      ShowDebug('Aborted by user');
    end
    else
      FAbortDetected := False;
  finally
    { Ok, clear the semafor, allow next commands }
    Screen.Cursor := crDefault;
    ReturnValue := byte(ErrorOccured);
    ActiveThread := nil;
    FIsFinished := True;
    FBusy := False;
    ReleaseSemaphore(FWaitCompleteIsBusyEvent,1,nil);
  end;
end;

function TWaitThread.GetLastError: string;
begin
  Result := DebugStr;
end;

function TWaitThread.Get_IsErrorOccur: Boolean;
begin
  Result := ErrorOccured and (GetLastError <> '');
end;

procedure TWaitThread.ShowDebug(str: String);
begin
  DebugStr := str;
  { Synchronize hangs up when caling fma.function from am.function,
    to avoid such issues, use only DoDebug; (not recommended) }
  Synchronize(DoDebug);
end;

end.